Megarom/Megarom Macintosh CD Software (Quantum Leap)(1992).iso/COMPRESS/DeHQX-200/Source/DisplayHQX.p

Text File | 1991-08-23 | 4.4 KB | 193 lines | [TEXT/PJMM]

unit DisplayHQX;
{ DeHQX v2.0.0 © Peter Lewis, Aug 1991 }

interface

    uses
        FixMath, MyTypes, MyUtilities, MyFileSystem, MySystem7, MyLists, AppGlobals, Displays, HQXLists, ReadHQX;

    procedure OpenDisplay (var wp: windowPtr);
    procedure DisplayOpen (wp: windowPtr; hi: hqxinfo);
    procedure DisplayFork (wp: windowPtr; fork: forkType; i: longInt; oe: OSErr);
    procedure DisplayFinish (wp: windowPtr; oe: OSErr);
    procedure DisplayClose (wp: windowPtr);
    procedure CloseDisplay (var wp: windowPtr);

implementation

    const
        k_char = 1;
        p_char = 2;
        s_char = 3;
        S_100Per = 1;
        S_Failed = 2;
        S_Chars = 3;
        S_Looking = 4;
        S_Dehqxing = 5;
        DI_Progress = 1;
        DI_Reading = 2;
        DI_Status = 10;
        DI_Name = 3;   { NB: Uses the fact that all info from Name to RsrcPer is cleared on DisplayClose }
        DI_Creator = 4;
        DI_Type = 5;
        DI_DataSize = 6;
        DI_DataPer = 7;
        DI_RsrcSize = 8;
        DI_RsrcPer = 9;

    type
        hqxInfoX = record
                whivalid: boolean;
                whi: hqxInfo;
                wfork: forkType;
                doe, roe: integer;
                di, dlen, ri, rlen: longInt;
            end;
        hqxInfoXP = ^hqxInfoX;

    var
        chars: string[3];

    function GetHqxInfoXP (wp: windowPtr): hqxInfoXP;
    begin
        GetHqxInfoXP := hqxInfoXP(GetWRefCon(wp));
    end;

    function NumToK (n: longInt): str255;
        var
            s: str255;
    begin
        NumToString((n + 1023) div 1024, s);
        s := Concat(s, chars[k_char]);
        NumToK := s;
    end;

    function GetDisplayStr (i: integer): str255;
        var
            s: str255;
    begin
        GetIndString(s, display_strh_id, i);
        GetDisplayStr := s;
    end;

    procedure OpenDisplay (var wp: windowPtr);
        var
            hixp: hqxInfoXP;
            it: integer;
            ih: handle;
            box: rect;
    begin
        chars := GetDisplayStr(S_Chars);
        wp := GetNewDialog(display_dialog_id, nil, POINTER(-1));
        GetDItem(wp, DI_Progress, it, ih, box);
        SetDItem(wp, DI_Progress, it, handle(@ProgressItem), box);
        SetItemText(wp, DI_Status, GetDisplayStr(S_Looking));
        hixp := POINTER(NewPtr(SizeOf(hqxInfoX)));
        hixp^.whivalid := false;
        SetWRefCon(wp, longInt(hixp));
    end;

    procedure DisplayOpen (wp: windowPtr; hi: hqxInfo);
        var
            hixp: hqxInfoXP;
            vrn: integer;
            dirID: longInt;
            fname: str63;
            oe: OSErr;
    begin
        hixp := GetHqxInfoXP(wp);
        hixp^.whi := hi;
        SetItemText(wp, DI_Reading, processing_name);
        SetItemText(wp, DI_Status, GetDisplayStr(S_Dehqxing));
        SetItemText(wp, DI_Name, hi.name);
        if hi.t = 'APPL' then begin
            SetItemText(wp, DI_Creator, hi.c);
            SetItemText(wp, DI_Type, 'Application');
        end
        else begin
            if MyGetAPPL(hi.c, vrn, dirID, fname) = noErr then
                SetItemText(wp, DI_Creator, fname)
            else
                SetItemText(wp, DI_Creator, hi.c);
            SetItemText(wp, DI_Type, hi.t);
        end;
        SetItemText(wp, DI_DataSize, concat(NumToK(hi.dlen), chars[s_char]));
        SetItemText(wp, DI_RsrcSize, concat(NumToK(hi.rlen), chars[s_char]));
        hixp^.whivalid := true;
        with hixp^ do begin
            wfork := no_fork;
            di := 0;
            dlen := hi.dlen;
            doe := noErr;
            ri := 0;
            rlen := hi.rlen;
            roe := noErr;
        end;
    end;

    procedure DisplayClose (wp: windowPtr);
        var
            hixp: hqxInfoXP;
            i: integer;
    begin
        hixp := GetHqxInfoXP(wp);
        hixp^.whivalid := false;
        SetItemText(wp, DI_Status, GetDisplayStr(S_Looking));
        for i := DI_Name to DI_RsrcPer do
            SetItemText(wp, i, '');
    end;

    procedure CloseDisplay (var wp: windowPtr);
        var
            hixp: hqxInfoXP;
    begin
        hixp := GetHqxInfoXP(wp);
        DisposPtr(ptr(hixp));
        DisposDialog(wp);
    end;

    procedure DisplayFork (wp: windowPtr; fork: forkType; i: longInt; oe: OSErr);
        var
            s1, s2: str255;
            pp, item: integer;
            len: longInt;
    begin
{ Only called between DisplayOpen and DisplayClose }
        ProgressItem(wp, DI_Progress);
        SetItemText(wp, DI_Reading, processing_name);
        with GetHqxInfoXP(wp)^ do begin
            wfork := fork;
            if fork = data_fork then begin
                di := i;
                len := dlen;
                doe := oe;
                item := DI_DataSize;
            end
            else begin
                item := DI_RsrcSize;
                ri := i;
                len := rlen;
                roe := oe;
            end;
        end;
        if len = 0 then
            s1 := GetDisplayStr(S_100Per)
        else begin
            NumToString((i * 100) div len, s1);
            s1 := Concat(s1, chars[p_char]);
        end;
        SetItemText(wp, item + 1, s1);
        if oe = noErr then
            SetItemText(wp, item, concat(NumToK(len), chars[s_char], NumToK(i)))
        else
            SetItemText(wp, item, GetDisplayStr(S_Failed));
    end;

    procedure DisplayFinish (wp: windowPtr; oe: OSErr);
    begin
        ProgressItem(wp, DI_Progress);
        SetItemText(wp, DI_Reading, processing_name);
{ Only called between DisplayOpen and DisplayClose }
    end;

end.